home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM A / PD-ROM A.iso / Programming / Programming Languages / Yerk / Supplement / Demo Folder / grDemo1 < prev    next >
Encoding:
Text File  |  1991-01-01  |  6.1 KB  |  172 lines  |  [TEXT/MACA]
  1. \ grdemo - source for Curves, a simple Yerk application
  2. \ 11/04/84  CBD Version 1
  3. \ 12/21/84  cbd simplified design based on new control classes
  4. \  2/18/84  cbd final for release 1.0
  5.  
  6. \ Define a class of special vertical scroll bars that 
  7. \ always show digital values for their thumb settings.
  8. :CLASS VSCtl  <Super vScroll
  9.  
  10.     Rect    readOut     \ visible rect around readout value
  11.     Rect    viewReadOut \ view rect for readout number is inset by 4 pixels.
  12.  
  13.     \ update the digital readout of the thumb value 
  14.     :M  DISPLAY:  GetTopX: viewReadOut getBotY: viewReadOut 1- gotoxy
  15.             -curs clear: viewReadOut  Get: super  3 .R  ;M
  16.  
  17.     \ redraw the readOut rect and display the value inside
  18.     :M  DRAW:  draw: readout  display: self   ;M
  19.  
  20.     \ ( val -- )  put new thumb value, draw the readout number
  21.     :M  PUT:  put: super  display: self  ;M
  22.  
  23.     \ Build new scroll bar - window must be created 1st
  24.     :M  NEW: { left top len  wind -- } left top len wind 
  25.             New: Super  1 tmode 9 tsize 1 tfont
  26.             \ calculate the coordinates for the readOut rectangles 
  27.             left 4-  top len + 4+ dup -> len        
  28.             left 20 + len 20 + put: readOut draw: readOut
  29.             get: readOut put: viewReadOut 3 3 inset: viewReadOut  ;M
  30.  
  31. ;CLASS
  32.  
  33. \ now, build three instances of class vSctl. These will be the
  34. \ three vertical scroll bars for Curves.
  35.    VSctl Vs1      \ three scroll bars for control of 
  36.    VSctl Vs2      \ graphics parameters by the user
  37.    VSctl Vs3       
  38.  
  39. \ assign constants to the window corners, so that we can change
  40. \ the size of the window and the length of the scroll bars will be
  41. \ adjusted automatically.  These constants relate to the global 
  42. \ coordinates of the Macintosh screen.
  43. 40  Value gwL    
  44. 60  Value gwT
  45. 470 Value gwR
  46. 290 Value gwB
  47. gwB gwT - 80 - Value vsLen  \ len of scroll bars 
  48.  
  49.  
  50. \ Define a subclass of CtlWind containing a drawing pane.
  51. \ The window will be a RoundDoc, draggable, non-growable.
  52. :CLASS grWind  <Super CtlWind 
  53.  
  54.     Rect    thePane \ this is where we'll draw the graphics
  55.     var        myDraw    \ this is the drawing word to be executed
  56.  
  57.     :M SETDRAW:  put: myDraw ;M
  58.                    
  59.     \ Create a new grWind with rounded corners and title passed by caller
  60.     :M  NEW: new: super grayRgn true setDrag: self  ;M     \ visible, no close box
  61.  
  62.     :M  CLEAR: clear: thePane draw: thePane ;M
  63.  
  64.     :M  PLOT: set: self clear: self
  65.         clip: thePane watchCurs
  66.         exec: myDraw arrowCurs        \ clip to the pane and draw
  67.         clip: contRect ;M            \ clip back to the entire window
  68.  
  69.     \ set defaults appropriate to this class
  70.     :M  CLASSINIT:   ClassInit: super    \ set window class defaults
  71.             4 15 320 220 put: thePane ;M
  72.  
  73. ;CLASS
  74.  
  75. \ instantiate grWind to create the Curves demo window.
  76. grWind dwind
  77.  
  78. scon dTitle "Yerk Curves"    \ title for dWind
  79.  
  80. \ ( -- p1 p2 p3 ) fetch the drawing parameters from the three scroll bars.
  81. : @dParms  get: vs1  get: vs2  get: vs3  ;
  82.  
  83. \ ( -- ) define the 4 draw: handlers, 1 for each type of drawing. 
  84. : Spiral  @dparms  PutRange: Bic    spiral: bic ;
  85. : spin    @dparms  putRange: anna   spin: anna  ;
  86. : Lj      @dparms  putRange: bic    lj: bic ;
  87. : dragon  @dparms   putRange: bic  home: bic 
  88.           get: vs1  dragon: bic  ;  \ dragon requires start val on stack 
  89.  
  90. \ store new parameter ranges for the three scroll bars.
  91. : !ranges  { max1 max2 max3 -- }  
  92.      1 max1 putRange: vs1  1 max2 putRange: vs2  
  93.      1 max3 putRange: vs3  ;
  94.      
  95. \ send the New: message to the window and scroll bars.
  96. \ this creates them within the Toolbox and displays them.
  97. : newObjs  close: fWind  gwL gwT gwR gwB put: tempRect
  98.             tempRect dTitle rndWind true true New: dWind   
  99.       340 40 vsLen  dWind  new: vs1  
  100.       370 40 vsLen  dWind  new: vs2 
  101.       400 40 vsLen  dWind  new: vs3    ; 
  102.  
  103.  
  104. scon ab1 "Curves was written in Yerk"
  105. scon ab2 "by Charles B. Duff" 
  106. scon ab3 "of Kriya Systems, Inc."
  107.  
  108. : about  0 tfont 0 tmode 12 tsize
  109.     8 40 Gotoxy ab1 type 
  110.     cr ab2 type cr ab3 type
  111.     initFont  ;    
  112.  
  113. \ tell the two Pen objects where to center themselves 
  114. \ when they do a Home: operation. Because these values will be retained
  115. \ in the pen objects when we do a SAVE, they can be set
  116. \ at compile time.
  117. 150 120 center: bic
  118. 150 120 center: anna
  119.  
  120. \ Define the actions for the various control parts.
  121. \ each action handler executes a deferred get: on the object whose
  122. \ address is on the method stack. Since the handler was called from
  123. \ the Exec: method of a vScroll object, the scroll bar's address 
  124. \ will be on the top of the mstack.  The handler then modifies the 
  125. \ value of the thumb, and causes thePane in dWind to be redrawn
  126. \ be adding its area to the current region.
  127.  
  128. : doThumb  get: myCtl put: myCtl plot: dwind ;
  129. : doPgUp    get: myCtl 10 - put: myCtl doThumb  ; 
  130. : doPgDn    get: myCtl 10 + put: myCtl doThumb  ; 
  131. : doLnUp    get: myCtl 1-   put: myCtl doThumb  ; 
  132. : doLnDn    get: myCtl 1+   put: myCtl doThumb  ; 
  133.  
  134. 'c lj setDraw: dwind
  135.  
  136. 5 'cfas  doLnUp doLnDn doPgUp doPgDn doThumb  actions: vs1
  137. 5 'cfas  doLnUp doLnDn doPgUp doPgDn doThumb  actions: vs2
  138. 5 'cfas  doLnUp doLnDn doPgUp doPgDn doThumb  actions: vs3
  139.  
  140. \ define the menu for this application.  AppleMen is already there.
  141. 5 Menu Grafmen
  142.  
  143. \ Define the menu handler words. Each one sets a new handler
  144. \ for dWind's DRAW method, and then sets appropriate ranges and 
  145. \ titles for the scroll bars, and causes an update event.
  146. ( do Lissajous curves )
  147. : doLiss  'c lj setDraw: dwind 200 200 179 !ranges plot: dwind ;
  148.  
  149. ( do Spirals )
  150. : doSpiral  'c spiral setDraw: dwind 10 20 179 !ranges  plot: dwind ;
  151.  
  152. ( do spinPolys )
  153. : doSpin  'c spin setDraw: dwind 8 10 179 !ranges  plot: dwind ;
  154.  
  155. ( do Dragon curves )
  156. : doDrag   'c dragon setDraw: dwind 11 12 179 !ranges  plot: dwind ;
  157.  
  158. ( set max reps in bic )
  159. : setReps 300 putMax: bic 100 putMax: anna ;
  160.  
  161. : sayonara  bye  ;
  162.  
  163. \ startup word for the turtle graphics demo
  164. : dStart  1000 20 gotoxy " dmenu.txt" getmtxt newobjs  
  165.     150 120 center: bic  150 120 center: anna  
  166.     setReps doLiss  -echo -curs  ;
  167.     BEGIN  key drop AGAIN    ;  \ just loop and listen to events
  168.  
  169. : doPlot plot: dwind draw: vs1 draw: vs2  draw: vs3 ;
  170.  
  171. 4 'cfas null null doplot null actions: dwind
  172.